home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb8.arc / INDEX.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-02-23  |  28.6 KB  |  718 lines
  1. program index;
  2.  
  3. var
  4.    in_char : char;        { character returned by readakey function }
  5.    place : byte;          { pointer to current "position" of select screen }
  6.    col: byte;             { column on screen for display purposes }
  7.    count    : byte;       { temporary counter variable }
  8.    Filename : string[12]; { name of file to be deleted  }
  9.    num : integer;         { loop limit variable }
  10.    heaptop : ^integer;    { marker to start of free heapspace }
  11.    print_flag : boolean;  { true if printer attached }
  12.  
  13. type
  14.    filepointer = ^heapinfo; { establish 'filepointer' as pointer type }
  15.  
  16.    result = record
  17.             ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
  18.             end;
  19.  
  20.    heapinfo = record                    { format of heap records }
  21.               name : string[12];        { filename w/ extension }
  22.               description : string[80]; { descriptive string     }
  23.               next : filepointer;       { 'next' ptr in 2x link list }
  24.               last : filepointer;       { 'last' ptr in 2x link list }
  25.               end;
  26.  
  27.    fileinfo = record                    { format of disk file records }
  28.               name : string[12];        { filename w/ extension }
  29.               description : string[80]; { descriptive string     }
  30.               end;
  31.  
  32. var
  33.    first,current,last, tptra : filepointer;  { 2x link list pointers }
  34.    filerec : fileinfo;                       { filerec is current record from disk }
  35.    file1   : file of fileinfo;
  36.    intr_rec : result;
  37.  
  38. label  exit;
  39.  
  40. const
  41.      alpha : byte = 2;
  42.      background : byte = 1;
  43.  
  44. testline:array [1..42] of byte =
  45.      ($c9,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$bb,
  46.       $c8,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$cd,$bc);
  47.  
  48. testline2:array [1..21] of byte =
  49.      ($40,$40,$40,$40,$40,$40,$40,$40,$40,$40,$40,$40,$40,$40,$40,$40,$40,$40,$40,$40,$40);
  50.  
  51. vertlineleft:array [1..8] of byte =
  52.      ($c9,$ba,$ba,$ba,$ba,$ba,$ba,$c8);
  53.  
  54. vertlineleftback:array [1..8] of byte =
  55.      ($40,$40,$40,$40,$40,$40,$40,$40);
  56.  
  57. vertlineright:array [1..8] of byte =
  58.      ($bb,$ba,$ba,$ba,$ba,$ba,$ba,$bc);
  59.  
  60. vertlinerightback :array [1..8] of byte =
  61.      ($40,$40,$40,$40,$40,$40,$40,$40);
  62.  
  63. firstletter:array[1..6] of byte =
  64.      ($0f,$0f,$0f,$0f,$0f,$0f);
  65.  
  66. cursorlineaccent : array[1..12] of byte =
  67.      ($5f,$50,$50,$50,$50,$50,$50,$50,$50,$50,$50,$50);
  68.  
  69. cursorlinenormal:array[1..12] of byte =
  70.      ($0f,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07);
  71.  
  72. {*******************************************************************}
  73. function cursordown(pos,modval:byte) : byte;
  74. {*******************************************************************}
  75. {   this routine will return the updated value of the pointer 'pos'
  76.     for doing a cursor down movement.
  77.     'pos' = current pointer position (0 <= pos < modval)
  78.     'modval' = upper limit (ie count of items in list)
  79.  
  80.     example: if you have 5 items in the list, this function will return
  81.              a number between 0 & modval-1.  (0 & 4)                    }
  82.  
  83. begin
  84.    cursordown := (pos + 1) mod modval;
  85. end; { end of cursordown }
  86.  
  87. {*******************************************************************}
  88. function cursorup(pos,mod_val:byte) : byte;
  89. {*******************************************************************}
  90. {   this routine will return the updated value of the pointer 'pos'
  91.     for doing a cursor up movement.
  92.     'pos' = current pointer position (0 <= pos < modval)
  93.     'modval' = upper limit (ie count of items in list)
  94.  
  95.     example: if you have 5 items in the list, this function will return
  96.              a number between 0 & modval-1.  ( 0 & 4 )                  }
  97.  
  98. begin
  99.    cursorup := (pos + mod_val - 1) mod mod_val;
  100. end;  {end of cursorup }
  101.  
  102. {*******************************************************************}
  103. function readakey : char;
  104. {*******************************************************************}
  105. {   this function returns the value of a keystroke. If an extended keystroke
  106.     is used ( like a cursorkey), that keystroke is detected, and modified
  107.     as per below. This will assign normal codes to the cursor movements,
  108.     not the ones assigned by turbo pascal.                              }
  109.  
  110. var
  111.    in_key : char;
  112. begin
  113.    read(kbd,in_key);          { wait for a keystroke }
  114.    if keypressed then         { if an extended key, read keystroke }
  115.    begin
  116.       read(kbd,in_key);       { then the extended keystroke  }
  117.       case in_key of
  118.       'H' : in_key  := ^K; { vert tab (cursor up)}
  119.       'M' : in_key  := ^I; { cursor right (tab) }
  120.       'P' : in_key  := ^J; { line feed (cursor down)}
  121.       'K' : in_key  := ^S; { backspace (cursor left)}
  122.       'S' : in_key  := ^P; { DLE }
  123.       end;  { end of case }
  124.    end;
  125.    readakey := in_key;  { set value for return }
  126. end; { end of readakey }
  127.  
  128. {******************************************************************}
  129. procedure quickprint(Row,Col,HowMany,start_pos:integer;code,option:byte);
  130. {******************************************************************}
  131. { option 1 = print horizontally
  132.   option 2 = print vertically
  133.   option 3 = highlight alpha or background
  134.  
  135.   Row = starting row position
  136.   Col = starting screen column
  137.   Howmany = number of bytes to be displayed or highlighted
  138.   start_pos = either the offset of an array to be printed, or
  139.               the attribute byte value to be set
  140.   code = 2 for alpha bytes, 1 for backgrounds
  141.   option = as described above             }
  142.  
  143. var
  144.    Start: integer;     { starting offset into graphics ram }
  145.    count: integer;     { loop counter                      }
  146.  
  147. begin
  148.    Start := ((Row-1)*160) + (Col*2) - code;
  149.       for count := 0 to howmany-1 do
  150.       begin
  151.          if option = 3
  152.             then mem[$b800:start] := start_pos
  153.             else Mem[$b800:start] := mem[cseg:start_pos+count];   { set attribute byte    }
  154.          if option = 2 then start := start + 160
  155.                        else start := start + 2;          { increment to next byte}
  156.       end;
  157. end;  { end of quickprint }
  158.  
  159. {*******************************************************************}
  160. procedure movecursor(var place,col:byte;row,num,width:byte);
  161. {*******************************************************************}
  162. {  this proc will move a cursor between user define limits on the screen
  163.    place = current cursor position ( between 0 and # items-1 )
  164.    col = screen column where cursor starts
  165.    row = screen row where current cursor is
  166.    num = number of lines of cursor travel possible
  167.    width = width of cursor ( # characters )    }
  168.  
  169. begin
  170.    repeat
  171.       in_char := readakey;   { get a character from keyboard    }
  172.       case in_char of
  173.       ^K  : begin            { cursor up }
  174.                quickprint(row+place,col,width,ofs(cursorlinenormal),background,1);
  175.                place := cursorup(place,num);   { calc new row }
  176.                quickprint(row+place,col,width,ofs(cursorlineaccent),background,1);
  177.             end;
  178.       ^J  : begin            { cursor down }
  179.                quickprint(row+place,col,width,ofs(cursorlinenormal),background,1);
  180.                place := cursordown(place,num); { calc new row }
  181.                quickprint(row+place,col,width,ofs(cursorlineaccent),background,1);
  182.             end;
  183.  
  184.       end;  {end case}
  185.    until (in_char in [^M,^[,'R','r','W','w','D','d','I','i','Q','q','P','p','S','s','F','f']);
  186.    end;  {end movecursor}
  187.  
  188. {*******************************************************************}
  189. procedure putbox;
  190. {*******************************************************************}
  191. {  this procedure will put the 'box' on the screen for any given
  192.    routine. no parameters are passed.                             }
  193.  
  194. begin
  195.    clrscr;
  196.    quickprint(9,30,21,ofs(testline),alpha,1);
  197.    quickprint(9,30,21,ofs(testline2),background,1);
  198.    quickprint(16,30,21,ofs(testline)+21,alpha,1);
  199.    quickprint(16,30,21,ofs(testline2),background,1);
  200.    quickprint(9,30,8,ofs(vertlineleft),alpha,2);
  201.    quickprint(9,30,8,ofs(vertlineleftback),background,2);
  202.    quickprint(9,50,8,ofs(vertlineright),alpha,2);
  203.    quickprint(9,50,8,ofs(vertlinerightback),background,2);
  204.  
  205. end;  { end putbox}
  206.  
  207. {*******************************************************************}
  208. procedure init;
  209. {*******************************************************************}
  210. {  this procedure initializes the disk file this program requires
  211.    to be present. No parameters are passed. It checks for an existing
  212.    file, and warns if the file will be destroyed   }
  213.  
  214. begin
  215.    putbox;
  216.    gotoxy(34,9);write(' INITIALIZE ');
  217.  
  218.      {$i-}
  219.      reset(file1);
  220.      {$i+}
  221.      if ioresult <> 0          { file not in existance }
  222.         then begin
  223.              rewrite(file1);   { create file }
  224.              first := nil;     { set pointers for empty lists }
  225.              tptra := nil;     { set pointers for empty lists }
  226.              end
  227.  
  228.         else begin      { file exists - may be overwritten }
  229.              gotoxy(31,11);write('Index file exists.');
  230.              gotoxy(31,12);write('Current index file');
  231.              gotoxy(33,13);write('will be lost.');
  232.              gotoxy(32,14);write('Continue (Y/N)? ');
  233.              read(in_char);                            { read response }
  234.              if upcase(in_char) = 'Y'                  { if 'y' then do }
  235.                 then begin
  236.                      erase(file1);          { purge exist. file }
  237.                      rewrite(file1);        { create empty file }
  238.                      first := nil;          { set pointers for empty lists }
  239.                      tptra := nil;          { set pointers for empty lists }
  240.                      end;
  241.              end;
  242. end; { end of initialize }
  243.  
  244. {*******************************************************************}
  245. procedure showmenu;
  246. {********************************************************************}
  247. { this proc displays the main menu for the program }
  248. begin
  249.    putbox;              { draw box }
  250.    gotoxy(32,9);write(' INDEX Main Menu ');
  251.    gotoxy(35,10);write('Read files');
  252.    gotoxy(35,11);write('Write file');
  253.    gotoxy(35,12);write('Delete file');
  254.    gotoxy(35,13);write('Initialize');
  255.    gotoxy(35,14);write('Quit');
  256.    gotoxy(35,15);write('Print');
  257.    quickprint(10,35,6,ofs(firstletter),background,2);       {highlight first letter }
  258.    quickprint(10,35,12,ofs(cursorlineaccent),background,1); {display cursor }
  259.         { display help line }
  260.    gotoxy(10,25);textcolor(black);textbackground(lightgray);
  261.    write(chr($18),chr($19));textcolor(lightgray);textbackground(black);
  262.    write('-move bar. Select by pressing a ');textcolor(white);
  263.    write('highlighted ');textcolor(lightgray);
  264.    write('letter or ');textcolor(black);textbackground(lightgray);
  265.    write('<',chr($c4),chr($d9));textcolor(lightgray);textbackground(black);
  266.  
  267. end; { end of showmenu }
  268.  
  269. {******************************************************************}
  270. procedure select;
  271. {******************************************************************}
  272. {  this proc will allow the user to select any file from the list
  273.    to either read its contents, or delete it from the list. If there are
  274.    more files than space to show them, this function will allow
  275.    the user to scroll through the complete list.    }
  276.  
  277. var
  278.    row, col, place : byte;
  279. label exit;
  280.  
  281. begin
  282.   count := 0;row := 10; col := 35; place := 0; num := 6;
  283.   window(col,row,col+12,row+6);   { set window for filename display }
  284.   gotoxy(1,1);
  285.   if tptra = nil                  { check ptr to start of list }
  286.      then begin                   { if = nil: list empty   }
  287.           writeln('No current');
  288.           writeln('  files  ');
  289.           delay(5000);
  290.           goto exit;
  291.           end
  292.      else repeat                  { if <> nil: list has entries }
  293.           writeln(tptra^.name);   { display filename }
  294.           tptra := tptra^.next;   { move to next in list }
  295.           count := count + 1;
  296.           until (count = num) or (tptra = nil);  { continue until all displayed or window full }
  297.  window(col,row,col+12,row+5);    { reset window to 1 row smaller(takes care of last}
  298.                                   { writeln command and it reposition of the cursor }
  299.  tptra := first;                  { reset temp pointer }
  300.  gotoxy(col,row);quickprint(row,col,12,$70,background,3);
  301.  {*** loop from here until a file is selected *****}
  302.  repeat
  303.  in_char := readakey;             { grab a input character }
  304.  case in_char of
  305.  ^K : begin                       { cursor up}
  306.       if tptra^.last <> nil       { if <> nil, we can travel back through list }
  307.          then if place = 0        { if at top: need to scroll back }
  308.               then begin
  309.                    tptra := tptra^.last;    { go back one entry }
  310.                    gotoxy(1,1);
  311.                    { push (scroll) entries down and make room for one at top }
  312.                    insline;quickprint(row+place+1,col,12,$07,background,3);
  313.                    write(tptra^.name);
  314.                    quickprint(row+place,col,12,$70,background,3);
  315.                    end
  316.               else begin          { not at top: we can move cursor up w/o scroll }
  317.                    quickprint(row+place,col,12,$07,background,3);
  318.                    place := cursorup(place,num);
  319.                    quickprint(row+place,col,12,$70,background,3);
  320.                    tptra := tptra^.last;
  321.                    end;
  322.       end;
  323.  ^J : begin                        { move down }
  324.       if tptra^.next <> nil        { if <> nil, we can still travel forward in list }
  325.          then if place = num-1     { if =, we need to scroll screen up }
  326.                  then begin
  327.                       tptra := tptra^.next;     { get next entry }
  328.                       gotoxy(1,1);delline;      { scroll up and make room at bottom }
  329.                       quickprint(row+place-1,col,12,$07,background,3);
  330.                       gotoxy(1,num);            { goto bottom of screen }
  331.                       write(tptra^.name);       { display next filename }
  332.                       quickprint(row+place,col,12,$70,background,3);
  333.                       end
  334.                  else begin        { we can travel down (forward) w/o scroll }
  335.                       quickprint(row+place,col,12,$07,background,3);
  336.                       place := cursordown(place,num);
  337.                       quickprint(row+place,col,12,$70,background,3);
  338.                       tptra := tptra^.next;
  339.                       end;
  340.       end;
  341.  end; { end case }
  342.  until (in_char in [^M,^[,';']);
  343. exit:
  344.  window(1,1,80,25);          { reset window }
  345.  end; { end of select}
  346.  
  347. {*******************************************************************}
  348. procedure readfiles;
  349. {*******************************************************************}
  350. {  this proc reads the current contents of the index file and
  351.    sets up the double link list pointers. If the file 'INDEX.NDX'
  352.    is not on the disk, an error message is printed out   }
  353.  
  354. var
  355.    row, place, col : byte;
  356. begin
  357.    {$i-}
  358.    assign(file1,'INDEX.NDX');
  359.    reset(file1);
  360.    {$i+}
  361.    if ioresult <> 0
  362.       then begin  { file doesnt exist }
  363.            putbox;
  364.            gotoxy(36,9);write(' ERROR ');
  365.            gotoxy(32,11);write(' Program must be');
  366.            gotoxy(32,12);write('initialized first');
  367.            delay(5000);
  368.            end
  369.  
  370.       else begin          { file exists-set up double link lists }
  371.            first := nil;            { set initial pointers to nil }
  372.            tptra := nil;            { set initial pointers to nil }
  373.            while not eof(file1) do
  374.               begin
  375.               read(file1,filerec);              { read a record from file }
  376.               new(current);                     { grab pointer from pool }
  377.               current^.name := filerec.name;    { set name        }
  378.               current^.description := filerec.description; {set description }
  379.               current^.next := first;           { set forward pointer }
  380.               current^.last := nil;             { set backward pointer }
  381.               if first <> nil then first^.last := current;  { special case}
  382.               if first = nil then last := current;  {set 'last' pointer for kicks}
  383.               first := current;                 { update initial pointer }
  384.               tptra := current;                 { update initial pointer }
  385.               end;
  386.            end;
  387.  
  388. end; { end of readfiles }
  389.  
  390. {*************************************************************}
  391. procedure writefiles;
  392. {*************************************************************}
  393. {  this proc will add (insert) a file name/description into the
  394.    current link-list of files           }
  395.  
  396. var dummy : char;
  397. label exit;
  398. begin
  399.    putbox;     { display box }
  400.    gotoxy(36,9);write(' WRITE ');gotoxy(33,12);write('Enter filename:');
  401.    gotoxy(35,25);
  402.    textcolor(black);textbackground(lightgray);
  403.    write('<',chr($c4),chr($d9));
  404.    textcolor(lightgray);textbackground(black);
  405.    write('-exit');
  406.      { read filename to be added-if null, exit from this proc }
  407.    gotoxy(36,14);read(filerec.name);
  408.    if length(filerec.name) = 0 then goto exit;
  409.  
  410.    {******* convert filename to all caps *****}
  411.    for count := 1 to length(filerec.name) do
  412.       filerec.name[count] := upcase(filerec.name[count]);
  413.  
  414.    {******** check for existing filename first *********}
  415.    current := nil;
  416.    while tptra <> nil do
  417.    begin
  418.       if tptra^.name = filerec.name then current := tptra;
  419.       tptra := tptra^.next;
  420.    end;
  421.  
  422.    { set a window for easy display }
  423.    window(31,10,49,15);clrscr;writeln;
  424.    if current = nil   { file not currently in list }
  425.       then begin
  426.            writeln(' Enter description');
  427.            write('  (80 chars max.):');
  428.            window(1,1,80,25);                     { reset window }
  429.            quickprint(22,1,80,$70,background,3);  { highlight input line }
  430.            gotoxy(1,22);read(filerec.description);{ read description }
  431.            new(current);                          { grab new pointer from pool }
  432.            current^.name := filerec.name;               { set name }
  433.            current^.description := filerec.description; { set description }
  434.            current^.next := first;                      { set front pointer }
  435.            current^.last := nil;                        { set back pointer }
  436.            if first <> nil then first^.last := current; { special case pointer }
  437.            if first = nil then last := current;         { set 'last' ptr for kicks}
  438.            first := current;                      { update initial pointer }
  439.            tptra := current;                      { update initial pointer }
  440.            end
  441.       else begin       { file already in index file }
  442.            write('WARNING-description');
  443.            writeln('   exists. This');
  444.            writeln('  will overwrite.');
  445.            write('Continue (y/n) ? ');
  446.            read(dummy);                 { read response }
  447.            clrscr;
  448.            if upcase(dummy) = 'Y'
  449.               then begin                { update file entry }
  450.                    clrscr;writeln;
  451.                    writeln(' Enter description');
  452.                    write('  (80 chars max.):');
  453.                    window(1,1,80,25);                      { reset the window }
  454.                    quickprint(22,1,80,$70,background,3);   { highlight input line }
  455.                    gotoxy(1,22);read(filerec.description); { read response }
  456.                    current^.name := filerec.name;          { update name }
  457.                    current^.description := filerec.description; { update descr }
  458.                    tptra := first;                         { reset the temp pointer }
  459.                    end
  460.  
  461.               else window(1,1,80,25);           { reset window to normal }
  462.  
  463.            end;
  464. exit:
  465. end;  { end of writefiles }
  466.  
  467. {***************************************************************}
  468. procedure closeupshop;
  469. {***************************************************************}
  470. {  this proc will write the new file list out to the disk file. It
  471.    is used when the user selects the 'Q' option.     }
  472.  
  473. begin
  474.    rewrite(file1);             { reset file pointer }
  475.    while tptra <> nil do       { write out until end of lists }
  476.    begin
  477.       filerec.name := tptra^.name;
  478.       filerec.description := tptra^.description;
  479.       write(file1,filerec);
  480.       tptra := tptra^.next;    { update pointer to next item }
  481.    end;
  482.    close(file1);               { close the file }
  483. end;  {end of closeupshop }
  484.  
  485. {*************************************************************}
  486. procedure lookfile;
  487. {*************************************************************}
  488. {  this proc will allow the user to select which file to
  489.    view. It calls routine 'select'    }
  490.  
  491. label exit;
  492. begin
  493.    putbox;        { display box }
  494.    gotoxy(36,9);write('  READ  ');
  495.           { display help line }
  496.    gotoxy(7,25);textcolor(black);textbackground(lightgray);
  497.    write(chr($18),chr($19));textcolor(lightgray);textbackground(black);
  498.    write('-move bar. Select by pressing function key ');textcolor(white);
  499.    write('F1 ');textcolor(lightgray);
  500.    write('or ');textcolor(black);textbackground(lightgray);
  501.    write('<',chr($c4),chr($d9));textcolor(lightgray);textbackground(black);
  502.    write('.  ');textcolor(black);textbackground(lightgray);
  503.    write('Esc');textcolor(lightgray);textbackground(black);
  504.    write('-exit');
  505.  
  506.    select;       { return with file to be viewed ( or ESC to quit }
  507.    if in_char = ^[ then goto exit;   { ESC ? go back to main menu }
  508.    if tptra <> nil
  509.       then begin
  510.            gotoxy(1,22);
  511.            clreol;write(tptra^.description);      { write descrip. line }
  512.            quickprint(22,1,80,$40,background,3);  { highlight it }
  513.            repeat
  514.            until keypressed;                      { loop until key pressed }
  515.            end;
  516.    tptra := first;                                { reset temp pointer }
  517. exit:
  518.    end;  { end of lookfile }
  519.  
  520. {*************************************************************}
  521. procedure deletefiles;
  522. {*************************************************************}
  523. {  this proc will delete a given file from the link list. }
  524.  
  525. var
  526.    deleted  : boolean;
  527. label exit;
  528. begin
  529.    putbox;   { display box }
  530.    gotoxy(36,9);write(' DELETE ');
  531.              { display help line }
  532.    gotoxy(10,25);textcolor(black);textbackground(lightgray);
  533.    write(chr($18),chr($19));textcolor(lightgray);textbackground(black);
  534.    write('-move bar. Select by pressing function key ');textcolor(white);
  535.    write('F1 ');textcolor(lightgray);
  536.    write('or ');textcolor(black);textbackground(lightgray);
  537.    write('<',chr($c4),chr($d9));textcolor(lightgray);textbackground(black);
  538.    write('.  ');textcolor(black);textbackground(lightgray);
  539.    write('Esc');textcolor(lightgray);textbackground(black);
  540.    write('-exit');
  541.  
  542.    select;         { return with file to be deleted or ESC to exit }
  543.    if in_char = ^[ then goto exit;   { ESC ? - exit }
  544.    filename := tptra^.name;          { set file for deletion }
  545.    deleted := false;                 { set deleted flag to false }
  546.    if first = nil                    { empty list ? }
  547.       then writeln('nothing to delete')
  548.       else                           { list not empty-is it first item ? }
  549.           if first^.name = filename then
  550.               begin
  551.               first := first^.next;
  552.               first^.last := nil;
  553.               deleted := true;
  554.               end
  555.           else begin               { not first item-search for filename }
  556.                current := first^.next;
  557.              {  last := first; }
  558.                while (current <> nil) and (deleted = false) do
  559.                   begin  {traverse and delete }
  560.                   if current^.name = filename then { is current name the one ? }
  561.                       begin                        { yes }
  562.                       current^.last^.next := current^.next;
  563.                       if current^.next <> nil
  564.                          then current^.next^.last := current^.last;
  565.  
  566.                      { last^.next := current^.next;} { reset pointer }
  567.                      { last := current^.next;      } { reset pointer }
  568.                      { if last <> nil              } { special case }
  569.                      {      then last^.last := current^.last; }
  570.                       deleted := true;             { set deleted flag to true }
  571.                       end
  572.                   else         { move to next list name }
  573.                      begin
  574.                     { last := current;}          { update ptr of last entry }
  575.                      current := current^.next; { update ptr to next entry }
  576.                      end;
  577.                   end;
  578.                end;
  579.  
  580. exit:
  581. tptra := first;  { reset temp pointer }
  582. end;  { end of delete }
  583.  
  584. {*******************************************************************}
  585. procedure print;
  586. {*******************************************************************}
  587. {  this proc will print the contents of the link list on either
  588.    the printer, to the screen, or to a disk file   }
  589. var namefile : string[12];
  590.     file2 : text;
  591. label exit;
  592. begin
  593.    putbox;
  594.    gotoxy(37,9);write(' PRINT ');
  595.  
  596.    gotoxy(35,11);write('Screen');
  597.    gotoxy(35,12);write('File');
  598.    gotoxy(35,13);write('Printer');
  599.    quickprint(10,35,6,ofs(firstletter),background,2);
  600.    quickprint(11,35,12,ofs(cursorlineaccent),background,1);
  601.    gotoxy(7,25);textcolor(black);textbackground(lightgray);
  602.    write(chr($18),chr($19));textcolor(lightgray);textbackground(black);
  603.    write('-move bar. Select by pressing a ');textcolor(white);
  604.    write('highlighted ');textcolor(lightgray);
  605.    write('letter or ');textcolor(black);textbackground(lightgray);
  606.    write('<',chr($c4),chr($d9));textcolor(lightgray);textbackground(black);
  607.    write('.  ');textcolor(black);textbackground(lightgray);
  608.    write('Esc');textcolor(lightgray);textbackground(black);
  609.    write('-exit');
  610.  
  611.    place := 0;movecursor(place,col,11,3,12);
  612.    if in_char = ^[ then goto exit;
  613.    case in_char of
  614.    'S','s' : place := 0;
  615.    'F','f' : place := 1;
  616.    'P','p' : place := 2;
  617.    end;  { end case }
  618.    if place = 0 then clrscr;
  619.    if place = 1
  620.       then begin
  621.            window(31,10,49,15);clrscr;writeln;
  622.            writeln(' Enter filename:  ');
  623.            read(namefile);
  624.            if length(namefile) = 0 then goto exit;
  625.            assign(file2,namefile);
  626.            rewrite(file2);
  627.            end;
  628.    while tptra <> nil do
  629.       begin
  630.       filerec.name := tptra^.name;
  631.       filerec.description := tptra^.description;
  632.       case place of
  633.       0 : begin
  634.           writeln(filerec.name);
  635.           writeln(filerec.description);writeln;
  636.           delay(500);
  637.           end;
  638.       1 : writeln(file2,filerec.name:12,'  ',filerec.description);
  639.       2 : begin
  640.           if print_flag = true
  641.             then writeln(lst,filerec.name:12,'  ',filerec.description)
  642.             else begin
  643.                  clrscr;gotoxy(10,10);write('Printer error');delay(1000);
  644.                  end;
  645.           end;
  646.       end;  { end case }
  647.       tptra := tptra^.next;
  648.       end;
  649.       if place = 1 then close(file2);
  650.    tptra := first;
  651. exit:
  652. window(1,1,80,25);
  653. end; { end of print }
  654.  
  655. {**************************************************************}
  656. {*  main driver starts here ....                              *}
  657. {**************************************************************}
  658. begin
  659.    textmode(bw80);lowvideo;
  660.  
  661.    {******** set no visible cursor ********}
  662.    intr_rec.ax := $0100;
  663.    intr_rec.cx := $0f0f;
  664.    intr($10,intr_rec);
  665.  
  666.    {********** printer test ************}
  667.    print_flag := false;
  668.    place := port[$0379];
  669.    if place = $df then print_flag := true;
  670.    place := port[$03bd];
  671.    if place = $df then print_flag := true;
  672.  
  673.    readfiles;
  674.    repeat
  675.       clrscr;
  676.       showmenu;
  677.       place := 0;col := 35;
  678.       { no parms given so get cursor movement results }
  679.       movecursor(place,col,10,6,12);
  680.       { if in_char = ^M, then place has cursor position }
  681.       { else jump based on in_char value }
  682.       case in_char of { case #2 }
  683.       'R','r' : place := 0;
  684.       'W','w' : place := 1;
  685.       'D','d' : place := 2;
  686.       'I','i' : place := 3;
  687.       'Q','q' : place := 4;
  688.       'P','p' : place := 5;
  689.       end; { end case #2 }
  690.  
  691.       case place of   { case #1 }
  692.       0 : begin  { read }
  693.           lookfile;
  694.           end;
  695.       1 : begin   { write }
  696.           writefiles;
  697.           end;
  698.       2 : begin   { delete }
  699.           deletefiles;
  700.           end;
  701.       3 : begin   { init }
  702.           init
  703.           end;
  704.       4 : begin     { quit }
  705.           goto exit
  706.           end;
  707.       5 : begin   { print }
  708.           print;
  709.           end;
  710.       end; { end case #1 }
  711.  
  712.  until true = false;
  713.  
  714. exit:
  715.    closeupshop;
  716.    release(heaptop);
  717.    lowvideo;
  718. end.